home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbtool.exe / LITEBAR2.BAS < prev    next >
BASIC Source File  |  1991-11-18  |  5KB  |  119 lines
  1. '----------------------------------------------------------
  2. '  PROGRAM: LITEBAR2.BAS       PROGRAMMER: A. KELLETT
  3. '  DATE-WRITTEN: 11/01/91
  4. '  USING POWER BASIC V2.10A
  5. '
  6. '  THIS PROGRAM DISPLAYS A SIMPLE MENU WITH A FLOATING
  7. '  HILIGHTED BAR TO ALLOW EASY USER MENU CHOICES...
  8. '  VERSION: 1.00    LAST UPDATED: 11/12/91
  9. '----------------------------------------------------------
  10. $INCLUDE "KEYS.INC"
  11. $INCLUDE "COLORS.INC"
  12. CLS
  13.    '*** FOLLOWING ARE INITIAL SET UP VALUES FOR A QUICK DEMO ***
  14.    DIM MENU$(1:10)
  15.    XLINE% = 5:XCOLUMN% = 20
  16.    LOWVAL% = 1:HIVAL% = 10
  17.    MENU$(1) = " A....Format Floppy A: "
  18.    MENU$(2) = " B....Format Floppy B: "
  19.    MENU$(3) = " C....Spreadsheet      "
  20.    MENU$(4) = " D....Desktop Pub.     "
  21.    MENU$(5) = " E....Communications   "
  22.    MENU$(6) = " F....Mainframe Xfer   "
  23.    MENU$(7) = " G....Word Processor   "
  24.    MENU$(8) = " H....Database         "
  25.    MENU$(9) = " I....Time Scheduler   "
  26.    MENU$(10) = " J....E-mail system    "
  27.    KEYTOPRESS$ = " ABCDEFGHIJ" + UPARROW$ + DOWNARROW$ + CR$
  28. CALL LITEBAR1(MENU$(), LOWVAL%, HIVAL%, XLINE%, XCOLUMN%, KEYTOPRESS$,KEYPRESSED%)
  29.  
  30. LOCATE 22,1:PRINT USING "USER CHOICE WAS ##.  THE END...";KEYPRESSED%
  31.  
  32. END
  33. '   YOU NEED BOTH SUBROUTINES (LITEBAR1 AND LITEBAR2) IN YOUR PROGRAM.
  34. '   MENU.ARRAY$() - ARRAY CONTAINING THE MENU TEXT FOR ALL CHOICES
  35. '   LOWVAL%       - LOWEST CHOICE, SHOULD <ALWAYS> BE 1 !
  36. '   HIVAL%        - HIGHEST CHOICE, FOR 10 ITEM MENU SHOULD BE 10
  37. '   MLINE%        - FIRST LINE TO DISPLAY MENU CHOICES ON
  38. '   MCOLUMN%      - COLUMN TO START DISPLAYING MENU CHOICES ON
  39. '   VALIDKEYS$    - SHOULD CONTAIN ANY VALID KEYS YOU WILL ALLOW FOR
  40. '                   IE.  VALIDKEYS$ = " 01234567" + UPARROW$ + DOWNARROW$ + CR$
  41. '                   BE SURE THE INITIAL SPACE IS IN THERE AND SEE CHARS.INC
  42. '                   FOR DEFINED KEYS.
  43. '   KYPRESS%      - CONTAINS A NUMBER REPRESENTING WHICH MENU CHOICE WAS
  44. '                   HILIGHTED WHEN THE USER PRESSED THE <ENTER> KEY
  45. '   NOTES: THIS ROUTINE DOES NOT CHECK WHETHER THE MENU MAY GO BEYOND
  46. '          THE RIGHTMOST COLUMN AND "WRAP AROUND", AND IT DOESN'T
  47. '          CHECK WHETHER THE MENU WILL GO BEYOND THE LAST LINE OF
  48. '          THE DISPLAY AND "SCROLL UP" THE ENTIRE SCREEN.
  49. '
  50. '----------------------------------------------------------
  51. SUB LITEBAR1(MENU.ARRAY$(), LOWVAL%, HIVAL%, MLINE%, MCOLUMN%, VALIDKEYS$, KYPRESS%)
  52.    SHARED UPARROW$, DOWNARROW$, CR$
  53.    QUITFLAG% = 0:OLD.POS% = 1:NEW.POS% = 1
  54.    '**** DISPLAY INITIAL MENU CHOICES ****
  55.    FOR I% = LOWVAL% TO HIVAL%
  56.       LOCATE I% + MLINE%,MCOLUMN%:PRINT MENU.ARRAY$(I%)
  57.    NEXT I%
  58.    LOCATE I% + MLINE% + 2, MCOLUMN%:PRINT "PRESS <Enter> TO EXIT"
  59.    '**** LOOP UNTIL USER PRESSES <RETURN> KEY ****
  60.    WHILE QUITFLAG% = 0
  61.     CALL LITEBAR2(MENU.ARRAY$(), OLD.POS%, NEW.POS%, MLINE%, MCOLUMN%)
  62.     DO
  63.        KEYIN$ = INKEY$
  64.     LOOP UNTIL INSTR(VALIDKEYS$, KEYIN$) > 1
  65.     IF (KEYIN$ = "0" OR KEYIN$ = CR$) THEN
  66.        KYPRESS% = NEW.POS% :REM** WHICH KEY WAS THE CHOICE ON ?? **
  67.        QUITFLAG% = 1:REM** EXIT THIS SUBROUTINE **
  68.     ELSE
  69.        IF (KEYIN$ = UPARROW$ AND NEW.POS% > LOWVAL%) THEN
  70.          OLD.POS% = NEW.POS%
  71.          NEW.POS% = NEW.POS% - 1
  72.          CALL LITEBAR2(MENU.ARRAY$(), OLD.POS%, NEW.POS%, MLINE%, MCOLUMN%)
  73.        ELSE
  74.          IF (KEYIN$ = DOWNARROW$ AND NEW.POS% < HIVAL%) THEN
  75.            OLD.POS% = NEW.POS%
  76.            NEW.POS% = NEW.POS% + 1
  77.            CALL LITEBAR2(MENU.ARRAY$(), OLD.POS%, NEW.POS%, MLINE%, MCOLUMN%)
  78.          ELSE
  79.            IF (KEYIN$ = UPARROW$ AND NEW.POS% = 1) THEN
  80.              OLD.POS% = 1
  81.              NEW.POS% = HIVAL%
  82.              CALL LITEBAR2(MENU.ARRAY$(), OLD.POS%, NEW.POS%, MLINE%, MCOLUMN%)
  83.            ELSE
  84.              IF (KEYIN$ = DOWNARROW$ AND NEW.POS% = HIVAL%) THEN
  85.                OLD.POS% = HIVAL%
  86.                NEW.POS% = LOWVAL%
  87.                CALL LITEBAR2(MENU.ARRAY$(), OLD.POS%, NEW.POS%, MLINE%, MCOLUMN%)
  88.              ELSE
  89.                IF (KEYIN$ <> DOWNARROW$ AND KEYIN$ <> UPARROW$) THEN
  90.                  NEW.POS% = VAL(KEYIN$)
  91.                  CALL LITEBAR2(MENU.ARRAY$(), OLD.POS%, NEW.POS%, MLINE%, MCOLUMN%)
  92.                END IF
  93.              END IF
  94.            END IF
  95.          END IF
  96.        END IF
  97.     END IF
  98.    WEND
  99.  
  100. END SUB
  101. '
  102. '
  103. '----------------------------------------------------------
  104. SUB LITEBAR2(MENU.ARRAY$(), OLD.POS%, NEW.POS%, MLINE%, MCOLUMN%)
  105.    SHARED BLACK%, HIGH.INTENSITY.WHITE%, WHITE%, RED%
  106.    '** BY ALTERNATING THE COLORS FOR EACH LINE, INSTEAD OF A HILIGHT BAR, **
  107.    '** YOU CAN HAVE A LINE OF DIFFERENT COLORED TEXT W/SAME COLOR BACKGROUND **
  108.    LOCATE OLD.POS% + MLINE%,MCOLUMN%
  109.    '*** SET COLORS FOR NORMAL TEXT AND REVERSE (HILIGHT) BARS BELOW ***
  110.    COLOR WHITE%,BLACK%:PRINT MENU.ARRAY$(OLD.POS%):COLOR BLACK%,WHITE%
  111.    LOCATE NEW.POS% + MLINE%,MCOLUMN%
  112.    '*** HILIGHT THE FOLLOWING LINE ***
  113.    COLOR BLACK, RED%:PRINT MENU.ARRAY$(NEW.POS%)
  114.       COLOR WHITE%, BLACK%
  115.    OLD.POS% = NEW.POS%
  116.  
  117. END SUB
  118.  
  119.